円周・球面の固有値分解

円周

円周上に「量子力学的固有状態～固有波動関数」を乗せるとすると ただの円か、周波数を少しずつ増やしながらサインカーブが円周上に乗ったようなものが出てくる

固有状態は「固有値分解」するとよいので、かなり細かく点をとったサイクルグラフでその様子を確認してみる

上下のオフダイアゴナルに値１が入っていることと、対角線から一番遠い２点にも１が入っている形になることに注意

library(igraph)

## 
## Attaching package: 'igraph'

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

n <- 100
edge.list <- cbind(1:n,c(2:n,1))
g <- graph.edgelist(edge.list,directed=FALSE)
ad.mat <- as.matrix(get.adjacency(g))

image(ad.mat)

eigen.out <- eigen(ad.mat)
eg.val <- eigen.out[[1]]
plot(eg.val) # コサインカーブになっていることに注意

固有ベクトルは？

V <- eigen.out[[2]]
matplot(V[c(1:n,1),1:10],type="l")

matplot(V[c(1:n,1),11:20],type="l")

円周に現れる固有状態は、正規直交関数であって、それはフーリエ変換の構成関数

じゃあ、球面に対して同じことをすると、「球面調和関数」が現れそうです

やってみる

球面

球面を模して、それなりに細かい均等点配置のメッシュグラフを作って、固有値分解してみる

library(devtools)
install_github("ryamada22/Ronlyryamada")

## Skipping install of 'Ronlyryamada' from a github remote, the SHA1 (9c4d20f1) has not changed since last install.
##   Use `force = TRUE` to force installation

library(Ronlyryamada)
library(igraph)

sp.mesh <- my_sphere_tri_mesh(n.psi=40)
xyz <- sp.mesh$xyz

plot3d(sp.mesh$xyz)
segments3d(sp.mesh$xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

g <- graph.edgelist(sp.mesh[[2]],directed=FALSE)

ad <- get.adjacency(g)
ad. <- as.matrix(ad)

固有値の分布は何か、意味のあるものなのかもしれないけれど、プロットからすぐには思いつかない。

eigenout<- eigen(ad.)
plot(eigenout[[1]])

k <- 1
L <- ceiling(sqrt(k))-1
M <- 0
ttl <- paste("l=",L," m=", M)

new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])

plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)

segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.

k <- k+1
newL <- ceiling(sqrt(k))-1
if(newL > L){
  L <- newL
  M <- -L
}else{
  M <- M + 1
}
ttl <- paste("l=",L," m=", M)
#open3d()
new.xyz <- xyz * (eigenout[[2]][,k])/mean(eigenout[[2]][,k])
plot3d(new.xyz,main=ttl,xlab="",ylab="",zlab="",axes=FALSE)
segments3d(new.xyz[c(t(sp.mesh$edge)),])

You must enable Javascript to view this page properly.